;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(require "iResize.lisp")
(require "iimage.lisp")
(require "icommon.lisp")

(module MResize
  (include-book "list-utilities" :dir :teachpacks)
  (include-book "io-utilities" :dir :teachpacks)
  (include-book "avl-rational-keys" :dir :teachpacks)
  (import IImage)
  (import ICommon)
  
  ;-----BEGINING OF EXPAND RESIZING SECTION-------------------------------------------------------------------------------;
  (defun calcBilinear (Q11Val Q21Val Q12Val Q22Val x1 x2 y1 y2 x y)
    (let* ((1stCal (* (truncate Q11Val (* (- x2 x1) (- y2 y1))) (* (- x2 x) (- y2 y))))
           (2ndCal (* (truncate Q21Val (* (- x2 x1) (- y2 y1))) (* (- x x1) (- y2 y))))
           (3rdCal (* (truncate Q12Val (* (- x2 x1) (- y2 y1))) (* (- x2 x) (- y y1))))
           (4thCal (* (truncate Q22Val (* (- x2 x1) (- y2 y1))) (* (- x x1) (- y y1)))))
      (+ 1stCal 2ndCal 3rdCal 4thCal)))  
  
  (defun calcAndInsertPix (newTree Q11 Q21 Q12 Q22 x1 x2 y1 y2 x y)
    (let* ((rVal (calcBilinear (car Q11) (car Q21) (car Q12) (car Q22) x1 x2 y1 y2 x y))
           (gVal (calcBilinear (cadr Q11) (cadr Q21) (cadr Q12) (cadr Q22) x1 x2 y1 y2 x y))
           (bVal (calcBilinear (caddr Q11) (caddr Q21) (caddr Q12) (caddr Q22) x1 x2 y1 y2 x y))
           (width (getWidth newTree))
           (height (getHeight newTree)))
      (if (isValidPixel x y width height)
          (insertPixel newTree x y rVal gVal bVal)
          newTree)))
  
  (defun validCord (nextX nextY beginWidth height)
    (if (AND (equal nextX beginWidth) (< nextY height))
        nil
        t))
  
  (defun calcNextY (y endOfX)
    (if (equal endOfX nil)
        y
        (- y 1)))
  
  (defun calcNextX (x x1 x2)
    (if (< x x2)
        (list (+ x 1) nil)
        (list x1 t)))
  
  ;Function sets up the starting locations of the interpolations and the ending locations and recursivelly calls itself for each location
  (defun bilinearInterpolateSquare (newTree Q11 Q21 Q12 Q22 x1 x2 y1 y2 x y)
    (let* ((listWithX (calcNextX x x1 x2))
           (nextX   (car listWithX))
           (endOfX  (cadr listWithX))
           (nextY (calcNextY y endOfX))
           (modTree (calcAndInsertPix newTree Q11 Q21 Q12 Q22 x1 x2 y1 y2 x y )))
      (if (validCord nextX nextY x1 y2)
          (bilinearInterpolateSquare modTree Q11 Q21 Q12 Q22 x1 x2 y1 y2 nextX nextY)
          modTree)))
  
  ;function will return a list of the lists of row elements.
  (defun getListOfMatchingRowPix (listOfOldTreeElementsAndNewLocationPairs rowNum returnList partialList)
    (let* ((nextElement (car listOfOldTreeElementsAndNewLocationPairs))
           (newPartialList (if (equal (cadr nextElement) rowNum) (append partialList (list nextElement)) (list nextElement)))
           (newRowNum      (cadr nextElement))
           (newReturnList  (if (equal (cadr nextElement) rowNum) returnList (append returnList (list partialList)))))
      (if (consp (cdr listOfOldTreeElementsAndNewLocationPairs))
          (getListOfMatchingRowPix (cdr listOfOldTreeElementsAndNewLocationPairs) newRowNum newReturnList newPartialList)
          (append newReturnList (list newPartialList)))))

  
  ;function sets up for the bilinearInterpolation of bottom Right corner
  (defun interPolateBottomRightCorner (treeWithRightSectionCalculated topLeftCorner defaultXIncrement defaultYIncrement)
    (let* ((Q11 (caddr topLeftCorner))
           (Q21 (caddr topLeftCorner))
           (Q12 (caddr topLeftCorner))
           (Q22 (caddr topLeftCorner))
           (x2  (+ (car topLeftCorner) defaultXIncrement))
           (x1  (car topLeftCorner))
           (y1  (+ (cadr topLeftCorner) defaultYIncrement))
           (y2  (cadr topLeftCorner))
           (modifiedtree (bilinearInterpolateSquare treeWithRightSectionCalculated Q11 Q21 Q12 Q22 x1 x2 y1 y2 x1 y1)))
      modifiedtree))
  
  ;function sets up for the bilinear Interpolation of Right Section.
  (defun interPolateRightSection (treeWithBottomSectionCalculated farRightColumn defaultXIncrement defaultYIncrement)
    (let* ((bottomLeftElement (car farRightColumn))
           (topLeftElement (cadr farRightColumn))
           (trueTopLeftElement (if (equal topLeftElement nil) bottomLeftElement topLeftElement))
           (bottomRightElement bottomLeftElement)
           (topRightElement trueTopLeftElement)
           (Q11 (caddr bottomLeftElement))
           (Q21 (caddr bottomRightElement))
           (Q12 (caddr trueTopLeftElement))
           (Q22 (caddr topRightElement))
           (x2  (+ (car bottomLeftElement) defaultXIncrement))
           (x1  (car bottomLeftElement))
           (y1  (cadr bottomLeftElement))
           (y2  (if (equal topLeftElement nil) (- (cadr bottomLeftElement) defaultYIncrement) (cadr topLeftElement)))
           (modifiedTree (bilinearInterpolateSquare treeWithBottomSectionCalculated Q11 Q21 Q12 Q22 x1 x2 y1 y2 x1 y1)))
      (if (consp (cdr farRightColumn))
          (interPolateRightSection modifiedTree (cdr farRightColumn) defaultXIncrement defaultYIncrement)
          modifiedTree)))
  
  
  ;function will set up for the bilinear Interpolation of bottom section
  (defun interPolateBottomSection (treeWithMainPartCalculated bottomRow defaultXIncrement defaultYIncrement bottomLeftElement topLeftElement)
    (let* ((topRightElement (car bottomRow))
           (bottomRightElement topRightElement)
           (trueBottomLeftElement (if (equal bottomLeftElement nil) topRightElement bottomLeftElement))
           (trueTopLeftElement (if (equal topLeftElement nil) topRightElement topLeftElement))
           (Q11 (caddr trueBottomLeftElement))
           (Q21 (caddr bottomRightElement))
           (Q12 (caddr trueTopLeftElement))
           (Q22 (caddr topRightElement))
           (x2  (car topRightElement))
           (x1  (if (equal topLeftElement nil) (- x2 defaultXIncrement) (car topLeftElement)))
           (y1  (+ (cadr topRightElement) defaultYIncrement))
           (y2  (cadr topRightElement))
           (modifiedTree (bilinearInterpolateSquare treeWithMainPartCalculated Q11 Q21 Q12 Q22 x1 x2 y1 y2 x1 y1)))
      (if (consp (cdr bottomRow))
          (interPolateBottomSection modifiedTree (cdr bottomRow) defaultXIncrement defaultYIncrement bottomRightElement topRightElement)
          modifiedTree)))
  
  
  ;function continues set up for bilinear interpolation, this time for just one row
  (defun interPolateRowMainSection (newTree mainRow secondRow defaultXIncrement defaultYIncrement bottomLeftElement topLeftElement)
    (let* ((topRightElement (car secondRow))
           (trueBottomRightElement (car mainRow))
           (trueTopRightElement (if (equal topRightElement nil) trueBottomRightElement topRightElement))
           (trueBottomLeftElement (if (equal bottomLeftElement nil) trueBottomRightElement bottomLeftElement))
           (trueTopLeftElement (if (equal topLeftElement nil) (if (equal topRightElement nil) trueBottomRightElement topRightElement) topLeftElement))
           (Q11 (caddr trueBottomLeftElement))
           (Q21 (caddr trueBottomRightElement))
           (Q12 (caddr trueTopLeftElement))
           (Q22 (caddr trueTopRightElement))
           (x2  (car trueBottomRightElement))
           (x1  (if (equal bottomLeftElement nil) (- x2 defaultXIncrement) (car bottomLeftElement)))
           (y1  (cadr trueBottomRightElement))
           (y2  (if (equal secondRow nil) (- y1 defaultYIncrement) (cadr topRightElement)))
           (modifiedTree (bilinearInterpolateSquare newTree Q11 Q21 Q12 Q22 x1 x2 y1 y2 x1 y1)))
      (if (consp (cdr mainRow))
          (interPolateRowMainSection modifiedTree (cdr mainRow) (cdr secondRow) defaultXIncrement defaultYIncrement trueBottomRightElement trueTopRightElement)
          modifiedTree)))
  
  ;function will set up for the bilinear interpolation
  (defun interPolateMainSection (newTree listOfListsOfMatchingRowPixels defaultXIncrement defaultYIncrement)
    (let* ((mainRow (car listOfListsOfMatchingRowPixels))
           (secondRow (cadr listOfListsOfMatchingRowPixels))
           (modifiedTree (interPolateRowMainSection newTree mainRow secondRow defaultXIncrement defaultYIncrement '() '())))
      (if (consp (cdr listOfListsOfMatchingRowPixels))
          (interPolateMainSection modifiedTree (cdr listOfListsOfMatchingRowPixels) defaultXIncrement defaultYIncrement)
          modifiedTree)))
  ;getFarRightColumnFunction removes the last element in each row and returns a list of this elements
  (defun getFarRightColumn (listOfListsOfMatchingRowPixels returnList)
    (let* ((activeRow (car listOfListsOfMatchingRowPixels))
           (lastElement (car (reverse activeRow)))
           (newReturnList (append returnList (list lastElement))))
      (if (consp (cdr listOfListsOfMatchingRowPixels))
          (getFarRightColumn (cdr listOfListsOfMatchingRowPixels) newReturnList)
          newReturnList)))
    
  (defun insertOldElements (newTree oldTree returnList x y oldTreeWidth oldTreeHeight percentIncreaseW percentIncreaseH)
    (let* ((nextX (getNextXCoordinate x oldTreeWidth))
           (nextY (getNextYCoordinate x y oldTreeWidth))
           (pixel (getPixel oldTree x y))
           (newXLocation (- (round (* x (car percentIncreaseW)) 1) (cadr percentIncreaseW)))
           (newYLocation (- (round (* y (car percentIncreaseH)) 1) (cadr percentIncreaseH)))
           ;-- section to get old elements from the tree in a list --;
           (locationPixList (list newXLocation newYLocation pixel))
           ;-- end section to get old elements from the tree in a list--:
           (newPixRVal (car pixel))
           (newPixGVal (cadr pixel))
           (newPixBVal (caddr pixel)))
      (if (isValidPixel nextX nextY oldTreeWidth oldTreeHeight)
          (insertOldElements (insertPixel newTree newXLocation newYLocation newPixRVal newPixGVal newPixBVal)
                             oldTree (append returnList (list locationPixList)) nextX nextY oldTreeWidth oldTreeHeight percentIncreaseW percentIncreaseH)
          (list (append returnList (list locationPixList)) (insertPixel newTree newXLocation newYLocation newPixRVal newPixGVal newPixBVal)))))
  
  
  ;Function creates a new empty tree and inserts the old tree header to the new tree.    
  (defun createNewTree (tree newTreeWidth newTreeHeight oldTreeWidth oldTreeHeight percentIncreaseW percentIncreaseH)
    (let* ((oldHeader (getHeader tree))
           (newTree (insertOldElements
                     (avl-insert (avl-insert (avl-insert (empty-tree) -1 oldHeader) -2 newTreeWidth) -3 newTreeHeight)
                     tree '() 1 oldTreeHeight oldTreeWidth oldTreeHeight percentIncreaseW percentIncreaseH)))
      newTree))
  
  
  ;Function calculates what percentage each location in the old tree will be multiplied by to be placed in the right location in the 
  ;new tree.
  (defun calcPercentIncrease (currentTreeWidth currentTreeHeight newWidth newHeight)
    (let* ((npercentW (/ newWidth currentTreeWidth))
           (npercentH (/ newHeight currentTreeHeight))
           (frontDisplacementW  (floor (round npercentW 1) 2))
           (frontDisplacementH  (floor (round npercentH 1) 2))
           (npercentWDisplacementW (list npercentW frontDisplacementW))
           (npercentHDisplacementH (list npercentH frontDisplacementH)))
      (list npercentWDisplacementW npercentHDisplacementH)))
  
  
  ;function resizes images that are not going from square to nonsquare and from nonsquare to square
  (defun resizeProportional (tree currentTreeWidth currentTreeHeight newWidth newHeight)
    (let* ((percentIncrease (calcPercentIncrease currentTreeWidth currentTreeHeight newWidth newHeight))
           (percentIncreaseW (car percentIncrease))
           (percentIncreaseH (cadr percentIncrease))
           (oldTreeWidth (getWidth tree))
           (oldTreeHeight (getHeight tree))
           (listOfOldTreeElementsAndNewLocationPairsAndnewTree (createNewTree tree newWidth newHeight oldTreeWidth oldTreeHeight percentIncreaseW percentIncreaseH))
           (newTree (cadr listOfOldTreeElementsAndNewLocationPairsAndnewTree))
           (listOfOldTreeElementsAndNewLocationPairs (car listOfOldTreeElementsAndNewLocationPairsAndnewTree))
           (firstRowNumber (cadr (car listOfOldTreeElementsAndNewLocationPairs)))
           (listOfListsOfMatchingRowPixels (getListOfMatchingRowPix  listOfOldTreeElementsAndNewLocationPairs firstRowNumber '() '()))
           (bottomRow (car listOfListsOfMatchingRowPixels))
           (farRightColumn (getFarRightColumn listOfListsOfMatchingRowPixels '()))
           (firstElement (car listOfOldTreeElementsAndNewLocationPairs))
           (secondElement (cadr listOfOldTreeElementsAndNewLocationPairs))
           (secondRowFirstElement (car (car (cdr listOfListsOfMatchingRowPixels))))
           (defaultXIncrement (- (car secondElement) (car firstElement)))
           (defaultYIncrement (- (cadr firstElement) (cadr secondRowFirstElement)))
           (treeWithMainPartCalculated (interPolateMainSection newTree listOfListsOfMatchingRowPixels defaultXIncrement defaultYIncrement))
           (treeWithBottomSectionCalculated (interPolateBottomSection treeWithMainPartCalculated bottomRow defaultXIncrement defaultYIncrement '() '()))
           (treeWithRightSectionCalculated  (interPolateRightSection treeWithBottomSectionCalculated farRightColumn defaultXIncrement defaultYIncrement))
           (treeWithBottomRightCornerCalculated (interPolateBottomRightCorner treeWithRightSectionCalculated (car farRightColumn) defaultXIncrement defaultYIncrement)))
      (list treeWithBottomRightCornerCalculated '("Resize was successful"))))
  
  ;------END OF EXPAND RESIZING SECTION----------------------------------------------------------------------;
  
  
  
  
  
  
  
  
  ;------BEGINING OF SHRINKING RESIZING SECTION -------------------------------------------------------------;
  
  
  ;function will set up for calculating averages of R G and B values
  (defun getRGBAverage (oldTreePixelVals listLength rSum gSum bSum)
    (let* ((nextVal (car oldTreePixelVals))
           (newRSum (+ rSum (car nextVal)))
           (newGSum (+ gSum (cadr nextVal)))
           (newBSum (+ bSum (caddr nextVal))))
      (if (consp (cdr oldTreePixelVals))
          (getRGBAverage (cdr oldTreePixelVals) listLength newRSum newGSum newBSum)
          (list (round newRSum listLength) (round newGSum listLength) (round newBSum listLength)))))

  
  ;function will retrieve pixel values from old tree locations.
(defun getPixelVals (pixelCoordinates oldTree returnList)
    (let* ((nextLocation (car pixelCoordinates))
           (nextLocationVal (getPixel oldTree (car nextLocation) (cadr nextLocation)))
           (newReturnList (append returnList (list nextLocationVal))))
      (if (consp (cdr pixelCoordinates))
          (getPixelVals (cdr pixelCoordinates) oldTree newReturnList)
          newReturnList)))
           
    
  ;function will check if the nextX and nextY are within the representation Box
    (defun validCordShrink (nextX nextY beginWidth height)
    (if (AND (equal nextX beginWidth) (< nextY height))
        nil
        t))
  ;function calculates the next Coordinate in the Y direction.
  (defun calcNextYShrink (y endOfX)
    (if (equal endOfX nil)
        y
        (- y 1)))
  
  ;function calculates the next Coordinate in the X direction.
  (defun calcNextXShrink (x x1 x2)
    (if (< x x2)
        (list (+ x 1) nil)
        (list x1 t)))
  
  
  
  ;function will calculate the coordinates in a representation box.
  (defun getCoordinates (returnList minBoxW minBoxH maxBoxW maxBoxH x y)
    (let* ((listWithX (calcNextXShrink x minBoxW maxBoxW))
           (nextX (car listWithX))
           (endOfX (cadr listWithX))
           (nextY (calcNextYShrink y endOfX))
           (newReturnList (append returnList (list (list x y)))))
      (if (validCordShrink nextX nextY minBoxW minBoxH)
          (getCoordinates newReturnList minBoxW minBoxH maxBoxW maxBoxH nextX nextY)
          newReturnList)))
  
  ;function returns a list of all the coordinates in a representation box.
(defun calcCoordinates (x y pixRepSquareWidth pixRepSquareHeight centerValW centerValH newWidth newHeight)
  (let* ((maxBoxW (+ (* x pixRepSquareWidth) centerValW))
         (maxBoxH (+ (* y pixRepSquareHeight) centerValH))
         (maxBoxWTrue (if (equal x newWidth) (+ maxBoxW centerValW) maxBoxW))
         (maxBoxHTrue (if (equal y newHeight) (+ maxBoxH centerValH) maxBoxH))
         (minBoxW (- maxBoxWTrue  (- pixRepSquareWidth 1) ))
         (minBoxH (- maxBoxHTrue  (- pixRepSquareHeight 1) ))
         (minBoxWTrue (if (or (equal x 1) (equal x newWidth)) (- minBoxW centerValW) minBoxW))
         (minBoxHTrue (if (or (equal y 1) (equal y newHeight)) (- minBoxH centerValH) minBoxH))
         (listOfCoordinates (getCoordinates '() minBoxWTrue minBoxHTrue maxBoxWTrue maxBoxHTrue minBoxWTrue maxBoxHTrue)))
    listOfCoordinates))

           
  ;function will insert the calculated pixel values for the new tree.
  (defun insertCalculatedElements (newTree oldTree x y newWidth newHeight pixRepSquareWidth pixRepSquareHeight centerValW centerValH)
    (let* ((nextX (getNextXCoordinate x newWidth))
           (nextY (getNextYCoordinate x y newWidth))
           (pixelCoordinates  (calcCoordinates x y pixRepSquareWidth pixRepSquareHeight centerValW centerValH newWidth newHeight))
           (oldTreePixelVals (getPixelVals pixelCoordinates oldTree '()))
           (pixelVal (getRGBAverage oldTreePixelVals (len oldTreePixelVals) 0 0 0))
           (newPixRVal (car pixelVal))
           (newPixGVal (cadr pixelVal))
           (newPixBVal (caddr pixelVal)))
      (if (isValidPixel nextX nextY newWidth newHeight)
          (insertCalculatedElements (insertPixel newTree x y newPixRVal newPixGVal newPixBVal) oldTree nextX nextY newWidth newHeight pixRepSquareWidth pixRepSquareHeight centerValW centerValH)
          (insertPixel newTree x y newPixRVal newPixGVal newPixBVal))))
  
  ;function initializes the new tree with the old header and new size and calls function to insert the elements.
  (defun createNewTreeShrink (oldTree newWidth newHeight pixRepSquareWidth pixRepSquareHeight centerValW centerValH)
    (let* ((oldHeader (getHeader oldTree))
           (newTree (insertCalculatedElements 
                     (avl-insert (avl-insert (avl-insert (empty-tree) -1 oldHeader) -2 newWidth) -3 newHeight)
                     oldTree 1 newHeight newWidth newHeight pixRepSquareWidth pixRepSquareHeight centerValW centerValH)))
      newTree))
  
  ;function determines how big of a squear from the old tree will represent on pixel in the new tree.
  (defun shrinkResize (tree currentTreeWidth currentTreeHeight newWidth newHeight)
    (let* ((pixRepSquareWidth (round currentTreeWidth newWidth))
           (pixRepSquareHeight (round currentTreeHeight newHeight))
           (centerValW (floor (- currentTreeWidth (* pixRepSquareWidth newWidth)) 2))
           (centerValH (floor (- currentTreeHeight (* pixRepSquareHeight newHeight)) 2))
           (newTree (createNewTreeShrink tree newWidth newHeight pixRepSquareWidth pixRepSquareHeight centerValW centerValH)))
      (list newTree '("Resize was successful"))))
  
  ;------END OF SHRINKING RESIZING SECTION -------------------------------------------------------------;
  
  ;function separates shrinking from expanding and calls the appropriate function
  (defun checkShrinkOrExpand (tree currentTreeWidth currentTreeHeight newWidth newHeight)
    (if (and (<= currentTreeWidth newWidth) (<= currentTreeHeight newHeight))
        (resizeProportional tree currentTreeWidth currentTreeHeight newWidth newHeight)
        (if (and (>= currentTreeWidth newWidth) (>= currentTreeHeight newHeight))
            (shrinkResize tree currentTreeWidth currentTreeHeight newWidth newHeight)
            (list tree '("Cannot mix shrinking and expanding")))))
  
  
  ;main function of resize
  (defun MainResize (tree args)
    (let* ((newWidth  (getElement args 1))
           (newHeight (getElement args 2))
           (currentTreeWidth (getWidth tree))
           (currentTreeHeight (getHeight tree))
           (returnTreeMessage (checkShrinkOrExpand tree currentTreeWidth currentTreeHeight newWidth newHeight))
           (returnTree (car returnTreeMessage))
           (message (cadr returnTreeMessage)))
      (mv returnTree message)))
  
  (export IResize))